home *** CD-ROM | disk | FTP | other *** search
/ Whiteline: Alpha / Whiteline Alpha.iso / progtool / modula2 / hk_lib / def_mod / converts.mod < prev    next >
Encoding:
Modula Implementation  |  1994-09-22  |  32.1 KB  |  1,001 lines

  1. IMPLEMENTATION MODULE  ConvertStr;
  2.  
  3. (*****************************************************************************)
  4. (*___________________________________________________________________________*)
  5. (* 05-Jan-90 , hk                                                            *)
  6. (*       Beginn                                                              *)
  7. (* 24-Jan-90 , hk                                                            *)
  8. (*       erste Version                                                       *)
  9. (* 03-Feb-90 , hk                                                            *)
  10. (*       "LastResult" neu                                                    *)
  11. (* 12-Feb-90 , hk                                                            *)
  12. (*       hinter den Stringrepraesentationen der zu wandelnden Werte koennen  *)
  13. (*       beliebige Begrenzungszeichen stehen ( "Chars.IsDelimiter" ),        *)
  14. (*       automatischer Fehlerreport, "NextIndex" neu.                        *)
  15. (*****************************************************************************)
  16.  
  17. FROM  SYSTEM IMPORT  (* TYPE *)  BYTE, WORD,
  18.                      (* PROC *)  SHORT, LONG, VAL, SHIFT, INLINE;
  19.  
  20. FROM  Chars  IMPORT  (* TYPE *)  CharClassTest,
  21.                      (* PROC *)  CardToDigit, DigitToCard,
  22.                                  CardToHexDigit, HexDigitToCard,
  23.                                  IsBinDigit, IsDigit, IsOctDigit, IsHexDigit,
  24.                                  IsGraphic, IsDelimiter;
  25.  
  26.  
  27. (*===========================================================================*)
  28. (*== LOKAL ==================================================================*)
  29.  
  30. VAR  lastResult  : ConvertResult;
  31.  
  32.      Convhandler : ConvHandler;
  33.      handlerOn   : BOOLEAN;
  34.  
  35.      aktProc     : ARRAY [0..13] OF CHAR;
  36.  
  37.      nextIdx     : INTEGER;
  38.  
  39. (*---------------------------------------------------------------------------*)
  40.  
  41. PROCEDURE  emptyConvHandler ((* EIN/ -- *) proc  : ARRAY OF CHAR;
  42.                              (* EIN/ -- *) error : ConvertResult );
  43. (*T*)
  44. (* nur damit das System nicht abstuerzt, falls aus irgendeinem
  45.    Grund der Handler aktiviert wird, obwohl keiner definiert wurde...
  46. *)
  47.  BEGIN
  48.  END  emptyConvHandler;
  49.  
  50. (*---------------------------------------------------------------------------*)
  51.  
  52. PROCEDURE  SkipBlanks ((* EIN/ -- *)     str  : ARRAY OF CHAR;
  53.                        (* EIN/AUS *) VAR idx  : INTEGER;
  54.                        (* -- /AUS *) VAR done : BOOLEAN       );
  55. (*T*)
  56. (* Wenn <done> = TRUE ist, gibt <idx> den Index in <str> an,
  57.    an dem das erste Zeichen steht, das nicht Blank ist.
  58.    Ist <done> = FALSE, besteht der String nur aus Blanks,
  59.    oder es wurde ein Controlzeichen ( <= 20H, 7FH ) gefunden,
  60.    bevor ein druckendes Zeichen gefunden wurde; <idx> ist in
  61.    diesem Fall ohne Bedeutung, und 'lastResult' = invalidDigit,
  62.    sonst 'lastResult' = converted.
  63.  
  64.  *)
  65.    BEGIN
  66.      WHILE  ( idx <= HIGH( str )) & ( str[ idx ] = ' ' )  DO
  67.        INC( idx );
  68.      END;
  69.  
  70.      nextIdx := idx;
  71.  
  72.      IF  ( idx <= HIGH( str )) & IsGraphic( str[ idx ])  THEN
  73.        done       := TRUE;
  74.        lastResult := converted;
  75.      ELSE
  76.        done       := FALSE;
  77.        lastResult := invalidDigit;
  78.  
  79.        IF  handlerOn  THEN
  80.          Convhandler( aktProc, invalidDigit );
  81.        END;
  82.      END;
  83.    END  SkipBlanks;
  84.  
  85. (*---------------------------------------------------------------------------*)
  86.  
  87. PROCEDURE  FormStr ((* EIN/ -- *)     feld,
  88.                     (* EIN/ -- *)     noetig : INTEGER;
  89.                     (* -- /AUS *) VAR idx    : INTEGER;
  90.                     (* -- /AUS *) VAR str    : ARRAY OF CHAR;
  91.                     (* -- /AUS *) VAR done   : BOOLEAN       );
  92. (*T*)
  93. (* Wenn in <str> mindestens fuer <noetig> Zeichen Platz ist, gilt
  94.    <done> = TRUE; in diesem Fall gibt <idx> die Position in <str>
  95.    an, ab der <noetig> Zeichen geschrieben werden koennen, sodass
  96.    sie rechtsbuendig im <feld> Zeichen langen <str> stehen; ist
  97.    <str> nicht gross genug, um <feld> Zeichen aufzunehmen, wird
  98.    <feld> entsprechend gekuerzt, der String ist aber mindestens
  99.    <noetig> Zeichen lang; er wird mit Leerzeichen bis <idx> gefuellt.
  100.    Die Zeichen ab <idx> sind undefiniert; der String ist in der be-
  101.    rechneten Laenge korrekt mit Nullbyte oder Feldende abgeschlossen,
  102.    sodass ab <idx> genau <noetig> Zeichen geschrieben werden muessen.
  103.    !! <noetig> muss groesser als Null sein !!
  104.    <done> = TRUE => 'lastChar' = converted, sonst strToShort.
  105.  *)
  106.    BEGIN
  107.       nextIdx := 0;
  108.  
  109.       IF  feld < noetig  THEN
  110.          feld := noetig;       (* mindestens <noetig> Zeichen *)
  111.       END;
  112.       DEC( feld ); DEC( noetig );
  113.  
  114.       done := noetig <= HIGH( str );
  115.       IF  ~done  THEN
  116.          (* Der String reicht nicht fuer mindestens
  117.           * <noetig> Zeichen.
  118.           *)
  119.          str[ 0 ] := 0C; idx := 0;
  120.          lastResult := strToShort;
  121.  
  122.          IF  handlerOn  THEN
  123.            Convhandler( aktProc, strToShort );
  124.          END;
  125.          RETURN;
  126.       END;
  127.       lastResult := converted;
  128.  
  129.       IF  HIGH( str ) <= feld THEN
  130.  
  131.          (* Wenn der String nicht fuer <feld> Zeichen ausreicht,
  132.           * wird der String eben kuerzer; er ist dann mit dem
  133.           * Feldende abgeschlossen.
  134.           *)
  135.          idx := HIGH( str ) - noetig;
  136.       ELSE
  137.          (* sonst wird der String auf <feld> Zeichen
  138.           * gekuerzt. Da der String nicht mit dem Feld-
  139.           * ende abgeschlossen wird, muss noch ein
  140.           * Nullbyte hinter dem letzten benoetigten Zeichen
  141.           * angefuegt werden.
  142.           *)
  143.          idx := feld - noetig;
  144.          str[ feld + 1 ] := 0C;
  145.       END;
  146.  
  147.       FOR  noetig := 0  TO  idx - 1 DO
  148.          (* String mit fuehrenden Leerzeichen auffuellen
  149.           * Der Rest ist egal, da er sowieso ueberschrieben
  150.           * wird.
  151.           *)
  152.          str[ noetig ] := ' ';
  153.       END;
  154.  
  155.    END  FormStr;
  156.  
  157. (*---------------------------------------------------------------------------*)
  158.  
  159. PROCEDURE  DecToStr ((* EIN/ -- *)     zahl   : LONGCARD;
  160.                      (* EIN/ -- *)     feld   : CARDINAL;
  161.                      (* EIN/ -- *)     signed : BOOLEAN;
  162.                      (* -- /AUS *) VAR string : ARRAY OF CHAR;
  163.                      (* -- /AUS *) VAR done   : BOOLEAN       );
  164. (*T*)
  165. (* Das ist eine allgemeine Prozedur zur Umwandlung von Dezimal-
  166.    zahlen ( positiv und negativ ) in Strings. <zahl> ist der zu
  167.    wandelnde Wert; ob er als INTEGER bzw. LONGINT-Wert zu in-
  168.    terpretieren ist, wird ueber <signed> mitgeteilt.
  169.    Der gewandelte Wert steht rechtsbuendig im <feld> Zeichen
  170.    langen String <string>. Benoetigt die Zahlendarstellung
  171.    mehr Zeichen als in <feld> angegeben, wird <string> ent-
  172.    sprechend laenger. Passt die Zahlendarstellung nicht in
  173.    das durch <string> repraesentierte Feld, gilt
  174.         <done> = FALSE.
  175. *)
  176.    VAR  negativ : BOOLEAN;
  177.         vorz    : CHAR;
  178.         i, idx  : INTEGER;
  179.         str     : ARRAY [0..11] OF CHAR;
  180.  
  181.    BEGIN
  182.      IF  signed  THEN
  183.         IF  VAL( LONGINT, zahl ) < 0D  THEN
  184.  
  185.            (* Wenn die Zahl negativ ist, Absolutwert
  186.             * nehmen und Vorzeichen separat merken.
  187.             *)
  188.            negativ := TRUE;
  189.  
  190.            zahl := - VAL( LONGINT, zahl );
  191.  
  192.            (* Falls <zahl> = MIN(LONGINT), veraendert sich
  193.             * die interne Zahlendarstellung nicht, da dieser
  194.             * Wert fuer eine Zahl mit Vorzeichen nicht als
  195.             * positiver Wert darstellbar ist ( unsymmetri-
  196.             * sche Zahlenbereiche bei Zweierkomplement );
  197.             * als LONGCARD interpretiert entspricht der
  198.             * kleinste negative Wert allerdings genau dem
  199.             * Wert nur mit positivem Vorzeichen.
  200.             *)
  201.            vorz := '-';
  202.         ELSE
  203.            vorz := ' ';
  204.         END; (* IF VAL(... *)
  205.  
  206.      END; (* IF signed *)
  207.  
  208.      i := 0;
  209.  
  210.      (* Die Zahl von hinten nach vorne in String wandeln;
  211.       * durch die REPEAT-Schleife wird auch die Null
  212.       * dargestellt.
  213.       *)
  214.  
  215.      REPEAT
  216.         str[ i ] := CardToDigit( zahl MOD 10D );
  217.         zahl     := zahl DIV 10D;
  218.         INC( i );
  219.      UNTIL  zahl = 0D;
  220.  
  221.      IF  signed  THEN
  222.         str[ i ] := vorz;
  223.         INC( i );
  224.      END; (* IF signed *)
  225.  
  226.      FormStr( feld, i, idx, string, done );
  227.  
  228.      IF  done  THEN
  229.  
  230.         (* Jetzt wird die Zahlendarstellung in umgekehrter
  231.          * Reihenfolge aus dem Hilfsstring in den eigentlichen
  232.          * String uebertragen.
  233.          *)
  234.         DEC( i );
  235.  
  236.         WHILE  i >= 0  DO
  237.            string[ idx ] := str[ i ];
  238.            INC( idx );
  239.            DEC( i );
  240.         END; (* WHILE *)
  241.      END; (* IF done *);
  242.  
  243.    END  DecToStr;
  244.  
  245. (*---------------------------------------------------------------------------*)
  246.  
  247. PROCEDURE  StrToDec ((* EIN/ -- *) VAR string : ARRAY OF CHAR;
  248.                      (* EIN/ -- *)     max    : LONGCARD;
  249.                      (* EIN/ -- *)     signed : BOOLEAN;
  250.                      (* -- /AUS *) VAR wert   : LONGCARD;
  251.                      (* -- /AUS *) VAR done   : BOOLEAN       );
  252. (*T*)
  253. (* Allgemeine Prozedur zur Wandlung von Strings in Dezimalzahlen
  254.    ( positiv und negativ ). <max> ist der groesste darstellbare
  255.    POSITIVE Wert fuer <wert>. Ist <signed> = TRUE, werden auch
  256.    negative Zahldarstellungen ( mit fuerendem '-' ) akzeptiert,
  257.    die kleinste darstellbare NEGATIVE Zahl ist dann   -(max + 1).
  258.    durch Interpretation von <wert> als negativer Zahl, werden
  259.    auch negative Werte korrekt zurueckgeliefert.
  260. *)
  261.    VAR  Index,
  262.         count  : INTEGER;
  263.         minus  : BOOLEAN;
  264.         vorz,
  265.         digit  : CHAR;
  266.         maxZehntel,
  267.         ziffer : LONGCARD;
  268.  
  269.    BEGIN
  270.      Index := 0;
  271.      wert  := 0;
  272.  
  273.      SkipBlanks( string, Index, done );
  274.      IF  ~done  THEN  RETURN  END;
  275.  
  276.      vorz  := string[ Index ];
  277.      minus := vorz = '-';
  278.  
  279.      (* Ein evtl. vorhandenes Vorzeichen wird gemerkt
  280.       * und ueberlesen.
  281.       *)
  282.      IF    vorz = '+'     THEN
  283.         (* Ein positives Vorzeichen ist immer erlaubt.
  284.          *)
  285.         INC( Index );
  286.      ELSIF signed & minus THEN
  287.  
  288.         (* Ein negatives Vorzeichen ist nur erlaubt,
  289.          * wenn <wert> auch negative Werte annehmen kann.
  290.          * Negative Zahlen haben einen um eins groesseren
  291.          * Wertebereich als positive Zahlen ( die Null
  292.          * ausgenommen ).
  293.          *)
  294.         INC( Index );
  295.         INC( max );
  296.      END;
  297.  
  298.      maxZehntel := max DIV 10D;
  299.  
  300.      count := Index;
  301.      LOOP
  302.         nextIdx := Index;
  303.  
  304.         (* Abbrechen, sobald der String zuende ist, oder
  305.          * ein Zeichen gefunden wurde, das keine Dezimal-
  306.          * ziffer ist.
  307.          *)
  308.         IF  Index > HIGH( string )  THEN  EXIT; END;
  309.  
  310.         digit := string[ Index ];
  311.         IF  ~IsDigit( digit ) THEN  EXIT;  END;
  312.  
  313.         ziffer := DigitToCard( digit );
  314.  
  315.         (* Da <wert> mit jedem neuen Digit um eine Dezimalstelle
  316.          * erweitert wird, wird fuer die Ueberlaufpruefung der
  317.          * bisherige <wert> vor der Erweiterung mit einem Zehntel
  318.          * des Maximalwertes verglichen; wuerde nach der Erweiterung
  319.          * verglichen, waere der Ueberlauf ja womoeglich schon passiert,
  320.          * und dabei koennte auch ein LONGCARD-Ueberlauf auftreten -
  321.          * ein Vergleich wuerde dann nur Unsinn produzieren.
  322.          * Ist der bisherige Wert kleiner als ein Zehntel des
  323.          * Maximums, kann kein Ueberlauf auftreten, ist der bisherige
  324.          * Wert gleich dem Maximumszehntel, muss geprueft werden, ob
  325.          * das neue Digit den Wert des letzten Digits des Maximums
  326.          * ueberschreitet.
  327.          *)
  328.         IF  ( wert < maxZehntel ) OR    ( wert = maxZehntel        )
  329.                                       & ( ziffer <= ( max MOD 10D ))
  330.         THEN
  331.            wert := wert * 10D + ziffer;
  332.         ELSE (* Ueberlauf *)
  333.            done       := FALSE;
  334.            lastResult := overflow;
  335.            wert       := 0D;
  336.  
  337.            IF  handlerOn  THEN
  338.              Convhandler( aktProc, overflow );
  339.            END;
  340.            RETURN;
  341.         END;
  342.  
  343.         INC( Index );
  344.      END; (* LOOP *)
  345.  
  346.      (* Die Wandlung war nur ok, wenn mindestens eine Ziffer
  347.       * angegeben wurde, und der String hinter der letzten Ziffer
  348.       * zuende ist oder mindestens ein Begrenzungszeichen folgt.
  349.       *)
  350.  
  351.      count := Index - count;
  352.      done := ( count >= 1 ) & (    ( Index > HIGH( string ))
  353.                                 OR   IsDelimiter( digit )   );
  354.  
  355.      IF  ~done  THEN
  356.         lastResult := invalidDigit;
  357.  
  358.         IF  handlerOn  THEN
  359.           Convhandler( aktProc, invalidDigit );
  360.         END;
  361.      ELSE
  362.         IF  signed & minus  THEN
  363.  
  364.            (* Wenn vor der Zahl ein '-' stand und negative
  365.             * Zahlen erlaubt sind, den bisher positiven
  366.             * Zahlenwert in einen negative wandeln.
  367.             *)
  368.             wert := - VAL( LONGINT, wert );
  369.         END;
  370.      END;
  371.  
  372.    END  StrToDec;
  373.  
  374. (*---------------------------------------------------------------------------*)
  375.  
  376. PROCEDURE  BinToStr ((* EIN/ -- *)     zahl   : LONGCARD;
  377.                      (* EIN/ -- *)     feld   : CARDINAL;
  378.                      (* EIN/ -- *)     basis  : Base;
  379.                      (* -- /AUS *) VAR string : ARRAY OF CHAR;
  380.                      (* -- /AUS *) VAR done   : BOOLEAN       );
  381. (*T*)
  382. (* Allgemeine Prozedur zur Wandlung positiver Zahlen
  383.    in Strings. Mit <basis> kann eine von vier Zahlenbasen
  384.    angegeben werden. Fuer die restlichen Parameter gilt
  385.    das unter "DecToStr" Gesagte.
  386.  *)
  387.    VAR  MODmask  : BITSET;
  388.         DIVshift : INTEGER;
  389.         str      : ARRAY [0..32] OF CHAR;
  390.         i, idx   : INTEGER;
  391.  
  392.    BEGIN
  393.      (* Die zur Wandlung benoetigten MOD- und DIV-
  394.       * Operationen koennen bei einer Zahlendarstellung
  395.       * durch Zweierpotenzen mit AND-( ueber den
  396.       * Umweg BITSET )und SHIFT-Operationen schneller
  397.       * erledigt werden.
  398.       *)
  399.  
  400.      IF     basis = dec  THEN
  401.         (* Wandlung von Dezimalzahlen erfolgt
  402.          * nicht hier ( laesst sich nicht durch
  403.          * Binaeoperationen erledigen ).
  404.          *)
  405.         DecToStr( zahl, feld, FALSE, string, done);
  406.         RETURN;
  407.      ELSIF  basis = hex  THEN
  408.         MODmask  := BITSET{ 0..3 };
  409.         DIVshift := -4;
  410.      ELSIF  basis = bin  THEN
  411.         MODmask  := BITSET{ 0 };
  412.         DIVshift := -1;
  413.      ELSE (* basis = oct *)
  414.         MODmask  := BITSET{ 0..2 };
  415.         DIVshift := -3;
  416.      END;
  417.  
  418.      i := 0;
  419.  
  420.      (* Die Zahl von hinten nach vorne in String wandeln;
  421.       * durch die REPEAT-Schleife wird auch die Null
  422.       * dargestellt.
  423.       *)
  424.  
  425.      REPEAT
  426.        str[ i ] := CardToHexDigit( VAL(CARDINAL,VAL(BITSET, zahl) * MODmask ));
  427.        zahl     := SHIFT( zahl, DIVshift );
  428.        INC( i );
  429.      UNTIL  zahl = 0D;
  430.  
  431.      FormStr( feld, i, idx, string, done );
  432.  
  433.      IF  done  THEN
  434.  
  435.         (* Jetzt wird die Zahlendarstellung in umgekehrter
  436.          * Reihenfolge aus dem Hilfsstring in den eigentlichen
  437.          * String uebertragen.
  438.          *)
  439.         DEC( i );
  440.  
  441.         WHILE  i >= 0  DO
  442.            string[ idx ] := str[ i ];
  443.            INC( idx );
  444.            DEC( i );
  445.         END; (* WHILE *)
  446.      END; (* IF done *);
  447.  
  448.    END  BinToStr;
  449.  
  450. (*---------------------------------------------------------------------------*)
  451.  
  452. PROCEDURE  StrToBin ((* EIN/ -- *) VAR string : ARRAY OF CHAR;
  453.                      (* EIN/ -- *)     max    : LONGCARD;
  454.                      (* EIN/ -- *)     basis  : Base;
  455.                      (* -- /AUS *) VAR wert   : LONGCARD;
  456.                      (* -- /AUS *) VAR done   : BOOLEAN       );
  457. (*T*)
  458. (* Wie "StrToDec", nur wird statt der konstanten Basis Zehn
  459.    eine angebbare benutzt.
  460. *)
  461.    VAR  Index,
  462.         count   : INTEGER;
  463.         minus   : BOOLEAN;
  464.         vorz,
  465.         digit   : CHAR;
  466.         maxZehntel,
  467.         ziffer  : LONGCARD;
  468.         gueltig : CharClassTest;
  469.         MODmask : BITSET;
  470.         DIVshift: INTEGER;
  471.  
  472.    BEGIN
  473.      IF     basis = dec  THEN
  474.         (* Wandlung von Dezimalzahlen erfolgt
  475.          * nicht hier ( laesst sich nicht durch
  476.          * Binaeoperationen erledigen ).
  477.          *)
  478.         StrToDec( string, max, FALSE, wert, done );
  479.         RETURN;
  480.      ELSIF  basis = hex  THEN
  481.         gueltig  := IsHexDigit;
  482.         MODmask  := BITSET{ 0..3 };
  483.         DIVshift := -4;
  484.      ELSIF  basis = bin  THEN
  485.         gueltig  := IsBinDigit;
  486.         MODmask  := BITSET{ 0 };
  487.         DIVshift := -1;
  488.      ELSE (* basis = oct *)
  489.         gueltig  := IsOctDigit;
  490.         MODmask  := BITSET{ 0..2 };
  491.         DIVshift := -3;
  492.      END;
  493.  
  494.      wert  := 0;
  495.      Index := 0;
  496.  
  497.      SkipBlanks( string, Index, done );
  498.      IF  ~done  THEN  RETURN  END;
  499.  
  500.      IF    vorz = '+'     THEN
  501.         (* Ein positives Vorzeichen ist immer erlaubt.
  502.          *)
  503.         INC( Index );
  504.      END;
  505.  
  506.      maxZehntel := SHIFT( max, DIVshift );
  507.  
  508.      count := Index;
  509.      LOOP
  510.         nextIdx := Index;
  511.  
  512.         IF  Index > HIGH( string )  THEN  EXIT; END;
  513.  
  514.         digit := string[ Index ];
  515.  
  516.         IF  ~gueltig( digit ) THEN  EXIT;  END;
  517.  
  518.         ziffer := HexDigitToCard( digit );
  519.  
  520.         IF    ( wert < maxZehntel )
  521.            OR ( wert = maxZehntel        )
  522.             & ( ziffer <= VAL( LONGCARD, VAL( BITSET, max ) * MODmask ))
  523.         THEN
  524.  
  525.            wert := SHIFT( wert, -DIVshift ) + ziffer;
  526.         ELSE (* Ueberlauf *)
  527.            done       := FALSE;
  528.            lastResult := overflow;
  529.            wert       := 0D;
  530.  
  531.            IF  handlerOn  THEN
  532.              Convhandler( aktProc, overflow );
  533.            END;
  534.            RETURN;
  535.         END;
  536.  
  537.         INC( Index );
  538.      END; (* LOOP *)
  539.  
  540.      count := Index - count;
  541.      done := ( count >= 1 ) & (    ( Index > HIGH( string ))
  542.                                 OR   IsDelimiter( digit )   );
  543.  
  544.      IF  ~done  THEN
  545.        lastResult := invalidDigit;
  546.  
  547.        IF  handlerOn  THEN
  548.          Convhandler( aktProc, invalidDigit );
  549.        END;
  550.      END; (* IF done *)
  551.  
  552.    END  StrToBin;
  553.  
  554. (*===========================================================================*)
  555. (*== EXPORT =================================================================*)
  556.  
  557. PROCEDURE  AssignConvHandler ((* EIN/ -- *) handler : ConvHandler );
  558. (*T*)
  559.  BEGIN
  560.    Convhandler := handler;
  561.    handlerOn   := TRUE;
  562.  END  AssignConvHandler;
  563.  
  564. (*---------------------------------------------------------------------------*)
  565.  
  566. PROCEDURE  UnAssignConvHandler;
  567. (*T*)
  568.  BEGIN
  569.    Convhandler := emptyConvHandler;
  570.    handlerOn   := FALSE;
  571.  END  UnAssignConvHandler;
  572.  
  573. (*---------------------------------------------------------------------------*)
  574.  
  575. PROCEDURE  LastConvResult ( ): ConvertResult;
  576. (*T*)
  577.  BEGIN
  578.    RETURN( lastResult );
  579.  END  LastConvResult;
  580.  
  581. (*---------------------------------------------------------------------------*)
  582.  
  583. PROCEDURE  NextIndex ( ): INTEGER;
  584. (*T*)
  585.  BEGIN
  586.    RETURN( nextIdx );
  587.  END  NextIndex;
  588.  
  589. (*---------------------------------------------------------------------------*)
  590.  
  591. PROCEDURE  BoolToStr ((* EIN/ -- *)     wert : BOOLEAN;
  592.                       (* EIN/ -- *)     feld : CARDINAL;
  593.                       (* -- /AUS *) VAR str  : ARRAY OF CHAR;
  594.                       (* -- /AUS *) VAR done : BOOLEAN       );
  595. (*T*)
  596.    VAR  i : INTEGER;
  597.  
  598.    BEGIN
  599.       aktProc := 'BoolToStr';
  600.  
  601.       FormStr( feld, 5 - ORD( wert ), i, str, done );
  602.  
  603.       IF  done  THEN
  604.          IF  wert  THEN
  605.            str[ i   ] := 'T';
  606.            str[ i+1 ] := 'R';
  607.            str[ i+2 ] := 'U';
  608.            str[ i+3 ] := 'E';
  609.          ELSE
  610.            str[ i   ] := 'F';
  611.            str[ i+1 ] := 'A';
  612.            str[ i+2 ] := 'L';
  613.            str[ i+3 ] := 'S';
  614.            str[ i+4 ] := 'E';
  615.          END; (* IF wert *)
  616.       END; (* IF done *)
  617.  
  618.    END  BoolToStr;
  619.  
  620. (*---------------------------------------------------------------------------*)
  621.  
  622. PROCEDURE  StrToBool ((* EIN/ -- *)     str  : ARRAY OF CHAR;
  623.                       (* -- /AUS *) VAR wert : BOOLEAN;
  624.                       (* -- /AUS *) VAR done : BOOLEAN       );
  625. (*T*)
  626.    VAR  Index : INTEGER;
  627.         ch    : CHAR;
  628.         noch  : CARDINAL;
  629.  
  630.    BEGIN
  631.      aktProc := 'StrToBool';
  632.  
  633.      Index := 0;
  634.  
  635.      SkipBlanks( str, Index, done );
  636.      IF  ~done  THEN  RETURN  END;
  637.  
  638.      noch := HIGH( str ) - Index;
  639.  
  640.      ch := CAP( str[ Index ] );
  641.  
  642.      done := ( ch = 'F' )  OR  ( ch = 'T' );
  643.  
  644.      IF  done  THEN
  645.  
  646.         (* Der boolsche Wert kann schon aus dem
  647.          * ersten Zeichen gewonnen werden
  648.          *)
  649.         wert := ch = 'T';
  650.  
  651.         IF  noch >= 1  THEN
  652.  
  653.            (* String ist noch nicht zuende,
  654.             * moeglicherweise folgen noch Zeichen
  655.             *)
  656.            ch := CAP( str[ Index+1 ] );
  657.  
  658.            IF  ~IsDelimiter( ch ) THEN
  659.  
  660.               (* Es schliesst sich tatsaechlich noch
  661.                * mindestens ein druckbares Zeichen an.
  662.                *)
  663.               IF  wert THEN
  664.  
  665.                  (* Wenn das erste Zeichen ein 'T' war, muss
  666.                   * noch Platz fuer mindestens drei Zeichen sein
  667.                   * damit ein 'TRUE' gebildet werden kann;
  668.                   * Folgt dahinter noch ein Zeichen, darf es nicht
  669.                   * druckbar sein.
  670.                   *)
  671.                  done :=   ( noch >= 3                     )
  672.                          & (      ch               = 'R'   )
  673.                          & ( CAP( str[ Index+2 ] ) = 'U'   )
  674.                          & ( CAP( str[ Index+3 ] ) = 'E'   )
  675.                          & (    (  noch = 3              )
  676.                              OR IsDelimiter( str[ Index+4 ]) );
  677.  
  678.               ELSE
  679.                  (* Wenn das erste Zeichen ein 'F' war, muss
  680.                   * noch Platz fuer mindestens vier Zeichen sein
  681.                   * damit ein 'FALSE' gebildet werden kann;
  682.                   * Folgt dahinter noch ein Zeichen, darf es nicht
  683.                   * druckbar sein.
  684.                   *)
  685.  
  686.                  done :=   ( noch >= 4                     )
  687.                          & (      ch               = 'A'   )
  688.                          & ( CAP( str[ Index+2 ] ) = 'L'   )
  689.                          & ( CAP( str[ Index+3 ] ) = 'S'   )
  690.                          & ( CAP( str[ Index+4 ] ) = 'E'   )
  691.                          & (    ( noch = 4               )
  692.                              OR IsDelimiter( str[ Index+5 ]) );
  693.  
  694.  
  695.               END; (* IF wert *)
  696.  
  697.               (* Diese Art der Abfrage funktioniert nur, weil
  698.                * nach dem ersten ungueltigen Ausdruck der
  699.                * Wahrheitswert feststeht und die weiteren
  700.                * Ausdruecke nicht mehr ausgewertet werden.
  701.                *)
  702.  
  703.               IF  done  THEN
  704.                 INC( Index, 4 - ORD( wert ));
  705.               END;
  706.            END; (* IF ~IsDelimiter *)
  707.         END; (* IF noch *)
  708.  
  709.      END; (* IF done *)
  710.  
  711.      nextIdx    := Index + 1;   (* stimmt nicht ganz... *)
  712.  
  713.      IF  ~done  THEN
  714.        lastResult := invalidDigit;
  715.  
  716.        IF  handlerOn  THEN
  717.          Convhandler( aktProc, invalidDigit );
  718.        END;
  719.      END;
  720.  
  721.    END  StrToBool;
  722.  
  723. (*---------------------------------------------------------------------------*)
  724.  
  725. PROCEDURE  BitsetToStr ((* EIN/ -- *)     menge: BITSET;
  726.                         (* EIN/ -- *)     feld : CARDINAL;
  727.                         (* -- /AUS *) VAR str  : ARRAY OF CHAR;
  728.                         (* -- /AUS *) VAR done : BOOLEAN       );
  729. (*T*)
  730.    VAR  Bit, idx : INTEGER;
  731.  
  732.    BEGIN
  733.      aktProc := 'BitsetToStr';
  734.  
  735.      FormStr( feld, 16, idx, str, done );
  736.  
  737.      IF  done  THEN
  738.  
  739.         FOR  Bit := 15  TO  0  BY  -1  DO
  740.            IF  Bit  IN  menge  THEN
  741.               str[ idx ] := '1';
  742.            ELSE
  743.               str[ idx ] := '0';
  744.            END;
  745.            INC( idx );
  746.         END; (* FOR *)
  747.      END; (* IF done *)
  748.  
  749.    END  BitsetToStr;
  750.  
  751. (*---------------------------------------------------------------------------*)
  752.  
  753. PROCEDURE  StrToBitset ((* EIN/ -- *)     str  : ARRAY OF CHAR;
  754.                         (* -- /AUS *) VAR menge: BITSET;
  755.                         (* -- /AUS *) VAR done : BOOLEAN       );
  756. (*T*)
  757.    VAR  idx, Bit : INTEGER;
  758.         digit    : CHAR;
  759.  
  760.    BEGIN
  761.      aktProc := 'StrToBitset';
  762.  
  763.      idx := 0;
  764.  
  765.      SkipBlanks( str, idx, done );
  766.      IF  ~done  THEN  RETURN  END;
  767.  
  768.      menge := BITSET{ };   (* dadurch nur Bits setzen, nicht loeschen *)
  769.      Bit   := 15;          (* mit dem hoechstwertigen Bit beginnen    *)
  770.  
  771.      LOOP
  772.  
  773.         (* Abbrechen, wenn der String zuende ist, ein Zeichen auftritt,
  774.          * das keine Binaerziffer ist oder bereits 16 Bits ermittelt
  775.          * wurden.
  776.          *)
  777.         IF  ( idx > HIGH( str )) OR ( Bit < 0 )  THEN  EXIT; END;
  778.  
  779.         digit := str[ idx ];
  780.         IF     digit = '1'  THEN
  781.            INCL( menge, Bit );
  782.         ELSIF  digit # '0'  THEN  (* keine Binaerziffer *)
  783.            EXIT;
  784.         END;
  785.  
  786.         INC( idx );
  787.         DEC( Bit );
  788.      END; (* LOOP *)
  789.  
  790.      nextIdx := idx;
  791.  
  792.      done := ( Bit = -1 ) & (( idx > HIGH( str )) OR IsDelimiter( str[ idx ]));
  793.  
  794.      IF  ~done  THEN
  795.        lastResult := invalidDigit;
  796.  
  797.        IF  handlerOn  THEN
  798.          Convhandler( aktProc, invalidDigit );
  799.        END;
  800.      END;
  801.  
  802.    END  StrToBitset;
  803.  
  804. (*---------------------------------------------------------------------------*)
  805.  
  806. PROCEDURE  CardToStr ((* EIN/ -- *)     wert : CARDINAL;
  807.                       (* EIN/ -- *)     feld : CARDINAL;
  808.                       (* -- /AUS *) VAR str  : ARRAY OF CHAR;
  809.                       (* -- /AUS *) VAR done : BOOLEAN       );
  810. (*T*)
  811.    BEGIN
  812.      aktProc := 'CardToStr';
  813.      DecToStr( wert, feld, FALSE, str, done);
  814.    END  CardToStr;
  815.  
  816. (*---------------------------------------------------------------------------*)
  817.  
  818. PROCEDURE  LongCardToStr ((* EIN/ -- *)     wert : LONGCARD;
  819.                           (* EIN/ -- *)     feld : CARDINAL;
  820.                           (* -- /AUS *) VAR str  : ARRAY OF CHAR;
  821.                           (* -- /AUS *) VAR done : BOOLEAN       );
  822. (*T*)
  823.    BEGIN
  824.      aktProc := 'LongCardToStr';
  825.      DecToStr( wert, feld, FALSE, str, done);
  826.    END  LongCardToStr;
  827.  
  828. (*---------------------------------------------------------------------------*)
  829.  
  830. PROCEDURE  StrToCard ((* EIN/ -- *)     str  : ARRAY OF CHAR;
  831.                       (* -- /AUS *) VAR wert : CARDINAL;
  832.                       (* -- /AUS *) VAR done : BOOLEAN       );
  833. (*T*)
  834.    VAR  langwert : LONGCARD;
  835.  
  836.    BEGIN
  837.      aktProc := 'StrToCard';
  838.      StrToDec( str, MAX(CARDINAL), FALSE, langwert, done );
  839.  
  840.      (* Auf keinen Fall mit SHORT() zuweisen,
  841.       * da SHORT() einen INTEGER-Wert liefert,
  842.       * und beim Bereichstest deshalb schon Alarm
  843.       * geschlagen wird, wenn <langwert> groesser
  844.       * als MAX(INTEGER) ist !!!
  845.       *)
  846.      wert := langwert;
  847.    END  StrToCard;
  848.  
  849. (*---------------------------------------------------------------------------*)
  850.  
  851. PROCEDURE  StrToLongCard ((* EIN/ -- *)     str  : ARRAY OF CHAR;
  852.                           (* -- /AUS *) VAR wert : LONGCARD;
  853.                           (* -- /AUS *) VAR done : BOOLEAN       );
  854. (*T*)
  855.    BEGIN
  856.      aktProc := 'StrToLongCard';
  857.      StrToDec( str, MAX(LONGCARD), FALSE, wert, done );
  858.    END  StrToLongCard;
  859.  
  860. (*---------------------------------------------------------------------------*)
  861.  
  862. PROCEDURE  IntToStr ((* EIN/ -- *)     wert : INTEGER;
  863.                      (* EIN/ -- *)     feld : CARDINAL;
  864.                      (* -- /AUS *) VAR str  : ARRAY OF CHAR;
  865.                      (* -- /AUS *) VAR done : BOOLEAN       );
  866. (*T*)
  867.    BEGIN
  868.      aktProc := 'IntToStr';
  869.      DecToStr( LONG( wert ), feld, TRUE, str, done);
  870.    END  IntToStr;
  871.  
  872. (*---------------------------------------------------------------------------*)
  873.  
  874. PROCEDURE  LongIntToStr ((* EIN/ -- *)     wert : LONGINT;
  875.                          (* EIN/ -- *)     feld : CARDINAL;
  876.                          (* -- /AUS *) VAR str  : ARRAY OF CHAR;
  877.                          (* -- /AUS *) VAR done : BOOLEAN       );
  878. (*T*)
  879.    BEGIN
  880.      aktProc := 'LongIntToStr';
  881.      DecToStr( wert, feld, TRUE, str, done);
  882.    END  LongIntToStr;
  883.  
  884. (*---------------------------------------------------------------------------*)
  885.  
  886. PROCEDURE  StrToInt ((* EIN/ -- *)     str  : ARRAY OF CHAR;
  887.                      (* -- /AUS *) VAR wert : INTEGER;
  888.                      (* -- /AUS *) VAR done : BOOLEAN       );
  889. (*T*)
  890.    VAR  langwert : LONGCARD;
  891.  
  892.    BEGIN
  893.      aktProc := 'StrToInt';
  894.      StrToDec( str, MAX(INTEGER), TRUE, langwert, done );
  895.      wert := VAL( INTEGER, langwert );
  896.    END  StrToInt;
  897.  
  898. (*---------------------------------------------------------------------------*)
  899.  
  900. PROCEDURE  StrToLongInt ((* EIN/ -- *)     str  : ARRAY OF CHAR;
  901.                          (* -- /AUS *) VAR wert : LONGINT;
  902.                          (* -- /AUS *) VAR done : BOOLEAN       );
  903. (*T*)
  904.    VAR  langwert : LONGCARD;
  905.  
  906.    BEGIN
  907.      aktProc := 'StrToLongInt';
  908.      StrToDec( str, MAX(LONGINT), TRUE, langwert, done );
  909.      wert := VAL( LONGINT, langwert);
  910.    END  StrToLongInt;
  911.  
  912. (*---------------------------------------------------------------------------*)
  913.  
  914. PROCEDURE  ShortNumToStr ((* EIN/ -- *)     wert : BYTE;
  915.                           (* EIN/ -- *)     basis: Base;
  916.                           (* EIN/ -- *)     feld : CARDINAL;
  917.                           (* -- /AUS *) VAR str  : ARRAY OF CHAR;
  918.                           (* -- /AUS *) VAR done : BOOLEAN       );
  919. (*T*)
  920.    BEGIN
  921.      aktProc := 'ShortNumToStr';
  922.      BinToStr( VAL( LONGCARD, wert ), feld, basis, str, done);
  923.    END  ShortNumToStr;
  924.  
  925. (*---------------------------------------------------------------------------*)
  926.  
  927. PROCEDURE  NumToStr ((* EIN/ -- *)     wert : WORD;
  928.                      (* EIN/ -- *)     basis: Base;
  929.                      (* EIN/ -- *)     feld : CARDINAL;
  930.                      (* -- /AUS *) VAR str  : ARRAY OF CHAR;
  931.                      (* -- /AUS *) VAR done : BOOLEAN       );
  932. (*T*)
  933.    BEGIN
  934.      aktProc := 'NumToStr';
  935.      BinToStr( VAL( LONGCARD, wert ), feld, basis, str, done);
  936.    END  NumToStr;
  937.  
  938. (*---------------------------------------------------------------------------*)
  939.  
  940. PROCEDURE  LongNumToStr ((* EIN/ -- *)     wert : LONGCARD;
  941.                          (* EIN/ -- *)     basis: Base;
  942.                          (* EIN/ -- *)     feld : CARDINAL;
  943.                          (* -- /AUS *) VAR str  : ARRAY OF CHAR;
  944.                          (* -- /AUS *) VAR done : BOOLEAN       );
  945. (*T*)
  946.    BEGIN
  947.      aktProc := 'LongNumToStr';
  948.      BinToStr( wert, feld, basis, str, done);
  949.    END  LongNumToStr;
  950.  
  951. (*---------------------------------------------------------------------------*)
  952.  
  953. PROCEDURE  StrToShortNum ((* EIN/ -- *)     str  : ARRAY OF CHAR;
  954.                           (* EIN/ -- *)     basis: Base;
  955.                           (* -- /AUS *) VAR wert : BYTE;
  956.                           (* -- /AUS *) VAR done : BOOLEAN       );
  957. (*T*)
  958.    VAR  langwert : LONGCARD;
  959.  
  960.    BEGIN
  961.      aktProc := 'StrToShortNum';
  962.      StrToBin( str, 255D, basis, langwert, done );
  963.      wert := VAL( CHAR, langwert );
  964.    END  StrToShortNum;
  965.  
  966. (*---------------------------------------------------------------------------*)
  967.  
  968. PROCEDURE  StrToNum ((* EIN/ -- *)     str  : ARRAY OF CHAR;
  969.                      (* EIN/ -- *)     basis: Base;
  970.                      (* -- /AUS *) VAR wert : WORD;
  971.                      (* -- /AUS *) VAR done : BOOLEAN       );
  972. (*T*)
  973.    VAR  langwert : LONGCARD;
  974.  
  975.    BEGIN
  976.      aktProc := 'StrToNum';
  977.      StrToBin( str, MAX(CARDINAL), basis, langwert, done );
  978.      wert := VAL( CARDINAL, langwert );
  979.    END  StrToNum;
  980.  
  981. (*---------------------------------------------------------------------------*)
  982.  
  983. PROCEDURE  StrToLongNum ((* EIN/ -- *)     str  : ARRAY OF CHAR;
  984.                          (* EIN/ -- *)     basis: Base;
  985.                          (* -- /AUS *) VAR wert : LONGCARD;
  986.                          (* -- /AUS *) VAR done : BOOLEAN       );
  987. (*T*)
  988.    BEGIN
  989.      aktProc := 'StrToLongNum';
  990.      StrToBin( str, MAX(LONGCARD), basis, wert, done );
  991.    END  StrToLongNum;
  992.  
  993. (*===========================================================================*)
  994.  
  995. BEGIN (* ConvertStr *)
  996.  
  997.   Convhandler := emptyConvHandler;
  998.   handlerOn   := FALSE;
  999.  
  1000. END  ConvertStr.
  1001.